Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/graphics/bitlin/getfile.frm

Visual Basic Form | 1995-05-23 | 8.8 KB | 317 lines

VERSION 2.00
Begin Form frmGetFile
   AutoRedraw      =   -1  'True
   Caption         =   "Select a file"
   Height          =   4575
   Left            =   2325
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   6225
   Top             =   1095
   Width           =   6345
   Begin TextBox txtWidth
      Height          =   285
      Left            =   5520
      TabIndex        =   17
      Top             =   1800
      Width           =   615
   End
   Begin TextBox txtHeight
      Height          =   285
      Left            =   5520
      TabIndex        =   16
      Top             =   1440
      Width           =   615
   End
   Begin PictureBox picFile2
      Height          =   615
      Left            =   6360
      Picture         =   GETFILE.FRX:0000
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   13
      Top             =   840
      Width           =   495
   End
   Begin PictureBox PicFile1
      Height          =   615
      Left            =   6360
      Picture         =   GETFILE.FRX:0302
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   12
      Top             =   120
      Width           =   495
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   495
      Left            =   4920
      TabIndex        =   11
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Height          =   495
      Left            =   4920
      TabIndex        =   10
      Top             =   120
      Width           =   1095
   End
   Begin DirListBox dirDirectory
      Height          =   2280
      Left            =   2640
      TabIndex        =   9
      Top             =   720
      Width           =   2175
   End
   Begin DriveListBox drvDrive
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   3600
      Width           =   2295
   End
   Begin ComboBox cboFileType
      Height          =   300
      Left            =   240
      Style           =   2  '
      TabIndex        =   4
      Top             =   3600
      Width           =   2175
   End
   Begin FileListBox filFiles
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   2175
   End
   Begin TextBox txtFileName
      Height          =   285
      Left            =   240
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin Label lblWidth
      Caption         =   "Width:"
      Height          =   255
      Left            =   4920
      TabIndex        =   15
      Top             =   1800
      Width           =   615
   End
   Begin Label lblHeight
      Caption         =   "Height:"
      Height          =   255
      Left            =   4920
      TabIndex        =   14
      Top             =   1440
      Width           =   615
   End
   Begin Image imgSample
      BorderStyle     =   1  '
      Height          =   1335
      Left            =   4920
      Top             =   2160
      Width           =   1215
   End
   Begin Label lblDirName
      Height          =   255
      Left            =   2640
      TabIndex        =   8
      Top             =   360
      Width           =   1455
   End
   Begin Label lblDirectories
      Caption         =   "Directories:"
      Height          =   255
      Left            =   2640
      TabIndex        =   7
      Top             =   120
      Width           =   975
   End
   Begin Label lbDrive
      Caption         =   "Drive:"
      Height          =   255
      Left            =   2640
      TabIndex        =   6
      Top             =   3360
      Width           =   975
   End
   Begin Label lblFileType
      Caption         =   "File Type:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   3360
      Width           =   735
   End
   Begin Label lblFileName
      Caption         =   "File Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
Dim LZHstatus
Dim LZHname
Sub cboFileType_Click ()
Dim patternpos1 As Integer
Dim patternpos2 As Integer
Dim patternlen As Integer
Dim Pattern As String
'Find starting position
patternpos1 = InStr(1, cbofiletype.Text, "(") + 1
'Find the end position
patternpos2 = InStr(1, cbofiletype.Text, ")") - 1
'Calculate the length of the pattern string
patternlen = patternpos2 - patternpos1 + 1
'Extract the pattern from the combo box
Pattern = Mid$(cbofiletype.Text, patternpos1, patternlen)
'set the pattern of the filfiles to the select pattern
filFiles.Pattern = Pattern
End Sub
Sub cmdCancel_Click ()
'Set the frmgetfile.tag to null
frmGetFile.Tag = ""
'Hide the frmgetfile
frmlha.Hide
frmGetFile.Hide
End Sub
Sub cmdDelete_Click ()
If txtFileName.Text = "" Then
  Exit Sub
End If
'Insert drive and path name
procInsPath
'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""
'Update file list
filFiles.Refresh
End Sub
Sub cmdDelete_DragDrop (Source As Control, X As Single, Y As Single)
cmdDelete_Click
End Sub
Sub cmdDelete_DragOver (Source As Control, X As Single, Y As Single, state As Integer)
Select Case state
  Case 0
    'change icon to release
     filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
     filFiles.DragIcon = picFile1
End Select
End Sub
Sub cmdOK_Click ()
Dim pathandname As String
Dim Path
'if no file is selected, exit this procedure
If txtFileName.Text = "" Then
  Exit Sub
End If
'Insert path name
procInsPath
'Hide frmgetfile
frmGetFile.Hide
End Sub
Sub dirDirectory_Change ()
'Change the path of the file list box
filFiles.Path = dirDirectory.Path
'Update lblDirName
lblDirName.Caption = dirDirectory.Path
End Sub
Sub dirDirectory_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
 'Change path
 dirDirectory.Path = dirDirectory.List(dirDirectory.ListIndex)
End If
End Sub
Sub DisplaySample ()
'Insert full path
procInsPath
'Display picture
imgSample.Picture = LoadPicture(frmGetFile.Tag)
'Display size
txtWidth.Text = imgSample.Width / screen.TwipsPerPixelX
txtHeight.Text = imgSample.Height / screen.TwipsPerPixelY
'if BMP too large then cut it off
If imgSample.Width > 1215 Then
  imgSample.Width = 1215
  txtWidth.Text = txtWidth.Text + "+"
End If
If imgSample.Height > 1335 Then
  imgSample.Height = 1335
  txtHeight.Text = txtHeight.Text + "+"
End If
End Sub
Sub drvDrive_Change ()
'Set Error trap
On Error GoTo DriveError
'Change the path of the directory list box to new drive
dirDirectory.Path = drvDrive.Drive
Exit Sub
'Error routine
DriveError:
'Restore to the original drive
MsgBox "Drive error!", 48, "Error"
drvDrive.Drive = dirDirectory.Path
Exit Sub
End Sub
Sub filFiles_Click ()
'Update the txtFileName text box
txtFileName = filFiles.FileName
End Sub
'Copyright 1995  by Hitoshi Ozawa
Sub filFiles_DblClick ()
'If it is a LHA file, open frmlha
If Right$(filFiles.FileName, 3) = "lzh" Then
 'Save file name in fname variable
 procInsPath
 frmlha.Show 1
 filFiles.FileName = frmlha.Tag
 Exit Sub
End If
'Update the txtfilename text box with selected file name
txtFileName = filFiles.FileName
'Display BMP file in imgSample
DisplaySample
End Sub
Sub filFiles_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Change drag icon
filFiles.DragIcon = picFile1
'Enable drag
filFiles.Drag
End Sub
Sub Form_Load ()
'Update the Directory lblDir Name with the path of directory list box
lblDirName.Caption = dirDirectory.Path
End Sub
Sub imgSample_DragDrop (Source As Control, X As Single, Y As Single)
DisplaySample
End Sub
Sub imgSample_DragOver (Source As Control, X As Single, Y As Single, state As Integer)
Select Case state
  Case 0
    'change icon when over
    filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
    filFiles.DragIcon = picFile1
End Select
End Sub
Sub txtFileName_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
  If (InStr(txtFileName.Text, "*") <> 0) Or (InStr(txtFileName.Text, "?") <> 0) Then
    'set the pattern of the filfiles to the select pattern
    filFiles.Pattern = txtFileName.Text
  End If
End If
End Sub